
(*
#load "common.cmo";;
#load "parse.cmo";;
 *)

open Common 
open Parse
module S = String

(* -------------------------------------------------------------------------- *)
(*  Variables                                                                 *)
(* -------------------------------------------------------------------------- *)

let temp_dir = ref "/tmp";;

let mathematica_command = ref "math";;

let infile() = !temp_dir ^ "/__ocaml_math_in.tmp";;

let outfile() = !temp_dir ^ "/__ocaml_math_out.tmp";;

let header = " -- Running Mathematica -- "

let dirs = ref []

let preamble = ref []

(* -------------------------------------------------------------------------- *)
(*  Parsing and Printing                                                      *)
(* -------------------------------------------------------------------------- *)

(* Quote the variable name so it doesn't happen to coincide
with a Mathematica value. *)
let pair_to_string (k,v) = "{\"" ^ k ^ "\"," ^ v ^ "}";;


let commands_to_string cs = curly(separate "," (map pair_to_string cs)) ^ "\n";;

(* copied from parse.ml to account for the different def of space *)
let space = matches " >\t\n" (* ignore mathematica output > for linebreak *)

let rec lex inp =
  let _,inp1 = lexwhile space inp in
    match inp1 with
        [] -> []
      | c::cs -> let prop =
          if alphanumeric(c) then alphanumeric
          else if symbolic(c) then symbolic
          else if punctuation(c) then (fun c -> false)
          else failwith "Unknown character in input" in
        let toktl,rest = lexwhile prop cs in
          (c^toktl)::lex rest;;

let make_parser pfn s =
  let expr,rest = pfn (lex(explode s)) in
    if rest = [] then expr else failwith "Unparsed input";;

let anything = some (fun x -> true);;

let rec innards bra n store l = match l with
  | [] -> raise (Parse "")
  | h::t -> 
      match h with 
        | "}" -> if n = 0 then concat(rev store),t else innards bra (n - 1) (h::store) t
        | "{" -> innards bra (n + 1) (h::store) t
        | _ -> innards bra n (h::store) t;;

let parse_pair = a "{" ++ anything ++ a "," ++ innards "}" 0 [] >> (fun (((_,x),_),y) -> x,y);;

let parse_math_output s = 
  let n1 = S.index s '{' in
  let n2 = S.rindex s '}' in
  let s' = S.sub s n1 (n2 - n1 + 1) in
    make_parser (a "{" ++ parse_bracketed (parse_list "," parse_pair) "}" >> snd) s';;

(* -------------------------------------------------------------------------- *)
(*  The main command                                                          *)
(* -------------------------------------------------------------------------- *)

let mathematica commands = 
  let outf = open_out (outfile()) in
  let write = output_stringl outf in
  let _ = 
    begin 
      (* print a header in Ocaml *)
      print_stringl header; 
      (* set up the path *)
      ignore(map (fun x -> write ("AppendTo[$Path," ^ quote x ^ "];")) !dirs);
      ignore(map write !preamble);
      write (commands_to_string commands);
      close_out outf;
      Sys.command (!mathematica_command ^ " < " ^ outfile() ^ " > " ^ infile());
    end in      
  let math_output = read_file (infile()) in
    parse_math_output math_output;;

(* -------------------------------------------------------------------------- *)
(*  User parsing commands                                                     *)
(* -------------------------------------------------------------------------- *)

type 'a parser = 'a Parse.parser;;

let parse_mlist p = a "{" ++ parse_bracketed (parse_list "," p) "}" >> snd;;

let parse_mpair p1 p2 = 
  a "{" ++ parse_bracketed (p1 ++ a "," ++ p2 >> (fun ((x,_),y) -> x,y)) "}" >> snd;;

let parse_bool = (a "True" || a "False") >> 
  (fun x -> match x with 
     | "True" -> true 
     | "False" -> false 
     | _ -> failwith ("parse_bool: not a bool: " ^ x));;

(*
let commands = ["sign","Pi >= 0"; "digits","RealDigits[Pi,2,54]"];;
let commands = ["pi","N[Pi,100]"; "e","N[Exp[1],100]"; "sqrt","Sqrt[2]//N"]
mathematica commands
 *)
